home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
United Public Domain Gold 2
/
United Public Domain Gold 2.iso
/
education
/
pe019.dms
/
pe019.adf
/
whip
/
whip.amosSourceCode
< prev
Wrap
AMOS Source Code
|
1991-03-25
|
23KB
|
1,106 lines
'
' ************************************************
' ** **
' ** DTP = Dunks Typing Programme **
' ** (C) 1992 Duncan Moran **
' ** **
' ** This PD version may be freely distributed **
' ** **
' ** Last amended 3/7/92 **
' ** **
' ************************************************
'
Dim A$(80)
Dim T$(80)
Global A$(),T$(),EOT,CHCNT,GOOD,K$,K,S,LASPC,MK,SEF,STAR,TLN,PCNT,SCUP,LSEF,BC
Global PSEL,SCRPOS,BEL,BSEL,PTX,PTY,PBX,PBY,XS,YS,XP,YP,LCNT,PAGE$,FRD,CHANGED
Global CM,TZ,MUS,IC,STP,SA,TED,TP,TXP,Z$,LIX,LIY,SLIX,SLIY,TM$,TT,TLL,BEOH,T1,F$
'
'
OFFWEGO
PAGESELECT
SETPAGE
BUTTONSUP
End
'
'
Procedure PAGESELECT
Unpack 11 To 5
Curs Off
For N=300 To 200 Step -1
Screen Display 5,,N,,
If N/2=Int(N/2) Then Wait Vbl
Next N
Screen 5
Reserve Zone 4
Limit Mouse
Set Zone 1,145,222 To 190,280
Set Zone 2,210,222 To 258,280
Set Zone 3,286,212 To 332,279
Set Zone 4,353,212 To 398,279
Repeat
SX=X Mouse
SY=Y Mouse
PSEL=Zone(5,SX,SY)
Until Mouse Click and PSEL>0
Screen 0 : Cls : Screen 1 : Cls
For N=200 To 300
Screen Display 5,,N,,
Wait Vbl
Mvolume(300-N)/1.75
Next N
LCNT=1
Music Off
Reserve Zone
Screen Close 5
End Proc
Procedure BUTTONSUP
Unpack 12 To 4
N=300
Screen Display 4,,N,,
Curs Off
For N=300 To 250 Step -1
Screen Display 4,,N,,
If N/2=Int(N/2) Then Wait Vbl
Next N
SCRPOS=250
SCRPOS=250
Reserve Zone 12
Set Zone 1,120,13 To 156,26
Set Zone 2,36,34 To 78,46
Set Zone 3,96,34 To 138,46
Set Zone 4,156,34 To 196,46
Set Zone 5,214,34 To 256,46
Set Zone 6,274,34 To 314,46
Set Zone 7,332,34 To 372,46
Set Zone 8,390,34 To 432,46
Set Zone 9,450,34 To 490,46
Set Zone 10,508,34 To 550,46
Set Zone 11,570,34 To 610,46
Set Zone 12,492,13 To 526,26
Limit Mouse
Do
Screen 4
Limit Mouse
WHICHBUTTON
Loop
End Proc
Procedure SETPAGE
On Menu Off
Menu Off
Screen 1 : Clip
Screen 0
Limit Mouse
Clip
Curs Off
Ink 0
TLL=620
If PSEL=1 Then Box 5,5 To 635,250 : Clip 1,1 To 2,2 : LIY=25 : TLN=10 : PTX=1 : PTY=1 : PBX=2 : PBY=2
If PSEL=2 Then Box 5,5 To 305,250 : Box 315,5 To 635,250 : Clip 315,5 To 635,250 : PTX=315 : PTY=5 : PBX=635 : PBY=250 : LIY=25 : TLN=10 : TLL=275
If PSEL=3 Then Box 5,5 To 635,135 : Box 5,150 To 635,250 : Clip 5,5 To 635,135 : PTX=5 : PTY=5 : PBX=635 : PBY=135 : LIY=168 : TLN=4
If PSEL=4 Then Box 5,5 To 635,220 : Box 5,225 To 635,250 : Clip 5,5 To 635,220 : PTX=5 : PTY=5 : PBX=635 : PBY=230 : LIY=245 : TLN=1
LIX=16
SLIX=LIX : SLIY=LIY
If LCNT>1
For N=1 To LCNT-1
LIY=LIY+24
Next N
End If
Screen Copy 0 To 1
Menu On
On Menu On
End Proc
Procedure WHICHBUTTON
On Menu On
MESS["Please select a tool or menu item."]
INITIN
BSEL=TZ
MESS[Space$(36)]
If BSEL<>8
Screen Copy 0 To 1
End If
On BSEL Proc MOVSC,SQ,CIRC,TRIANG,LINER,FHAND,DROP,UNDO,FIL,WIPER,DUN,MOVSC
End Proc
Procedure DROPBUT
End Proc
Procedure FIL
MESS["Click in the area to be filled"]
INITIN
If TZ=7 Then Pop Proc
MESS[Space$(36)]
MESS["Hang on a mo......."]
Screen 0
Ink IC : Set Pattern STP
Paint XS,YS,0
MESS[Space$(36)]
On Menu On
End Proc
Procedure SQ
MESS["Click on a corner"]
INITIN
If TZ=7 Then Pop Proc
MESS[Space$(36)]
MESS["Click on the opposite corner"]
Screen 0
Gr Writing 2
Do
Ink 8
XP=X Screen(X Mouse)
YP=Y Screen(Y Mouse)
Box XS,YS To XP,YP
Ink 1
Box XS,YS To XP,YP
Exit If Mouse Click
Loop
Gr Writing 1
Ink IC
Box XS,YS To XP,YP
MESS[Space$(36)]
End Proc
Procedure CIRC
MESS["Click on the centre spot"]
INITIN
If TZ=7 Then Pop Proc
MESS[Space$(36)]
MESS["Click when you have the right size"]
Screen 0
Gr Writing 2
Do
Ink 8
XP=X Screen(X Mouse)
YP=Y Screen(Y Mouse)
R1=XP-XS : R2=YP-YS
R1=Abs(R1) : R2=Abs(R2)
If R1=0 Then R1=1
If R2=0 Then R2=1
Ellipse XS,YS,R1,R2
Exit If Mouse Click
Ink 1
Ellipse XS,YS,R1,R2
Exit If Mouse Click
Loop
Gr Writing 1
Ink IC
Ellipse XS,YS,R1,R2
MESS[Space$(36)]
End Proc
Procedure TRIANG
MESS["Click on first corner"]
INITIN
If TZ=7 Then Pop Proc
X1=XS : Y1=YS
For N=1 To 2
MESS[Space$(36)]
MESS["Click on the next corner"]
Screen 0
Gr Writing 2
Do
Ink 8
XP=X Screen(X Mouse) : X2=XP
YP=Y Screen(Y Mouse) : Y2=YP
Draw XS,YS To XP,YP
Ink 1
Draw XS,YS To XP,YP
Exit If Mouse Click
Loop
Gr Writing 1
Ink IC
Draw XS,YS To XP,YP
XS=XP : YS=YP
Next N
Draw XP,YP To X1,Y1
MESS[Space$(36)]
End Proc
Procedure LINER
MESS["Click on the start point"]
INITIN
If TZ=7 Then Pop Proc
MESS[Space$(36)]
MESS["Click on the end point"]
Screen 0
Gr Writing 2
Do
Ink 8
XP=X Screen(X Mouse)
YP=Y Screen(Y Mouse)
Draw XS,YS To XP,YP
Ink 1
Draw XS,YS To XP,YP
Exit If Mouse Click
Loop
Gr Writing 1
Ink IC
Draw XS,YS To XP,YP
MESS[Space$(36)]
End Proc
Procedure FHAND
MESS["Press mouse key to draw "]
INITIN
If TZ=7 Then Pop Proc
MESS[Space$(36)]
MESS["Release when you have finished"]
Screen 0
Ink IC
While Mouse Key>0
XP=X Screen(X Mouse)
YP=Y Screen(Y Mouse)
Draw XS,YS To XP,YP
Wait Vbl
XS=XP : YS=YP
Wend
MESS[Space$(36)]
End Proc
Procedure DROP
MESS[Space$(36)]
End Proc
Procedure UNDO
Screen Copy 1 To 0
End Proc
Procedure WIPER
Screen 0
Cls 1,PTX,PTY To PBX,PBY
Ink 0
Box PTX,PTY To PBX,PBY
End Proc
Procedure FOURD
MESS[Space$(36)]
MESS["See you later!"]
For N=SCRPOS To 300
Screen Display 4,,N,,
If N/2=Int(N/2) Then Wait Vbl
Next N
Wait Vbl
End Proc
Procedure MOVSC
Volume 15
If BSEL=1
If MUS=1
MESS[" Going up ...."]
Else
MESS[" Going up.....quietly"]
End If
End If
If BSEL=12
If MUS=1
MESS[" Going down ..."]
Else
MESS[" Going down ... quietly"]
End If
End If
While Mouse Key
If BSEL=1 and SCRPOS>36 Then Dec SCRPOS
If BSEL=1 and SCRPOS=36 Then MESS["Roof garden and swimming pool"]
If BSEL=12 and SCRPOS<250 Then Inc SCRPOS
If BSEL=12 and SCRPOS=250 Then MESS["Rock bottom - send donations now!"]
Screen Display 4,,SCRPOS,,
If MUS=1 Then Bell 83-(SCRPOS/3.2)
Wait Vbl
Wend
MESS[Space$(36)]
Volume 20
End Proc
Procedure DUMMY
End Proc
Procedure MESS[M$]
Screen 4
Pen 3 : Paper 6
Locate 24,2
Print M$
End Proc
Procedure INITIN
Screen 0
Limit Mouse
Repeat
SCEN=Scin(X Mouse,Y Mouse)
If SCEN=4 and CM=2 Then Change Mouse 1 : CM=1 : If MUS=1 Then Sam Play 1
If SCEN=0 and CM=1 Then Change Mouse 2 : CM=2 : If MUS=1 Then Sam Play 2
If Y Mouse<45 and CM=2 and SCEN=0 Then Change Mouse 1 : CM=1 : If MUS=1 Then Sam Play 3
Screen SCEN
XS=X Screen(X Mouse)
YS=Y Screen(Y Mouse)
TZ=Zone(SCEN,XS,YS)
MK=Mouse Key
Until Mouse Click
If MUS=1 Then Sam Play 3
End Proc
Procedure EXT
If Choice(2)=1
Parent
Edit
End If
End Proc
Procedure DING
If MUS=0 Then Goto HERE
D=(Dreg(0)*20)+2000
DD=(Dreg(1)*30)+2000
SR=(D+DD*3) : If SA>1 Then SR=SR/2 : If SA=2 Then SR=SR*1.5
Sam Play 15,SA,SR
HERE:
End Proc
Procedure MUS
Change Mouse 1
If Choice(2)=1 Then MUS=0
If Choice(2)=2
MUS=1
SA=Choice(3)
End If
On Menu On
End Proc
Procedure CUL
Change Mouse 1
IC=Choice(2)
Dec IC
Ink IC
On Menu On
End Proc
Procedure FL
Change Mouse 1
If Choice(2)=1
STP=0
Else
STP=(Choice(2)+3)
End If
On Menu On
End Proc
Procedure ED
Change Mouse 1
' FOURD
'Load Iff "texbr.iff",5
'Spack 5 To 13
'Stop
Unpack 13 To 5
Screen 5
Get Palette 5
Screen Display 5,,300,,
For N=300 To 175 Step -1
Screen Display 5,,N,,
Wait Vbl
Next N
If SEF<>LSEF
CLTEX
End If
UPLINE
' Do
' Screen 5
' X=X Screen(X Mouse)
' Y=Y Screen(Y Mouse)
' Repeat : Until Mouse Click
' Screen 0
' Print X;" ";Y
' Loop
On Menu Off
Menu Off
TED=1
BEOH=10
End Proc
Procedure PGE
Change Mouse 1
If Choice(2) Then PAGESELECT : SETPAGE
On Menu On
End Proc
Procedure EX
LSEF=SEF
SEF=(Choice(2)+2)
STAR=15
If PSEL<>2
If SEF=6 or SEF=9
STAR=2
End If
End If
On Menu On
End Proc
Procedure EDBUTDOWN
Wait Vbl
If Not SCUP
Screen Display 5,,300,,
For N=175 To 300
Screen Display 5,,N,,
If N/2=Int(N/2)
Wait Vbl
End If
Next N
Wait Vbl
Else
Wait Vbl
MOVTXSCD
Wait Vbl
For N=175 To 300
Screen Display 5,,N,,
If N/2=Int(N/2)
Wait Vbl
End If
Next N
Wait Vbl
End If
Screen Close 5
If FRD Then FOURUP
Screen 4
Limit Mouse
End Proc
Procedure TEX
SETUP
Do
If CHCNT>EOT Then EOT=CHCNT
' Screen 0
' Cls
' Home : Cline : Home
' Print "SEF:";SEF
' Print "chcnt:";CHCNT
' Print "TT:";TT
' Print "TLL";TLL
' Print "K:";K
' Print "GOOD:";GOOD
' Print "EOT:";EOT
' Print "laspc:";LASPC
'Screen 5
GRABAKEY
CHECKAKEY
PLOPIT
Exit If TED=0
Loop
Menu On
On Menu On
KLIPPERG
Curs Off
MESS[Space$(36)]
MESS["Click left button to continue"]
Ink IC
End Proc
Procedure GRABAKEY
TZ=0 : MK=0 : K=0 : S=0
Clear Key
Repeat
K$=Inkey$
K=Asc(K$)
S=Scancode
TZ=Zone(X Screen(X Mouse),Y Screen(Y Mouse))
MK=Mouse Click
Until K$<>"" or MK<>0
End Proc
Procedure CHECKAKEY
If K>$1F and K<$7F
GOOD=-1
Else
GOOD=0
If TZ>0 and MK<>0
If TZ=1
K=27
End If
If TZ=2
K=8
End If
If TZ=3
S=70
End If
If TZ=4
PASTE
End If
If TZ=5
WIPER
Screen 5
LIX=SLIX : LIY=SLIY
LCNT=1 : UPLINE
End If
If TZ=6
If LCNT<TLN
Inc LCNT
UPLINE
LIY=LIY+24
End If
End If
If TZ=7
If LCNT>1
Dec LCNT
DWNLINE
LIY=LIY-24
End If
End If
If TZ=8
K=30
End If
If TZ=9
K=29
End If
If TZ=10
K=28
End If
If TZ=11
K=13
End If
If TZ=12
If Not SCUP
MOVTXSC
Else
MOVTXSCD
End If
End If
End If
If K=8 and CHCNT>1
TEXL[" "] : TT=TT+T1
Cleft : Print " "; : A$(CHCNT)=" " : Cleft : Dec CHCNT
End If
If K=29 and CHCNT>1
Cleft : Dec CHCNT
End If
If K=28 and CHCNT<EOT
Cright : Inc CHCNT
End If
If K=30
INSY
End If
If S=70
DELI
End If
If K=27
EDBUTDOWN
TED=0
End If
If K=13
CLTEX
End If
End If
End Proc
Procedure DELI
TEXL[A$(CHCNT)]
TT=TT-T1
For N=CHCNT To EOT
A$(N)=A$(N+1)
Next N
A$(EOT+1)=" "
Curs Off
Locate STAR,6
For N=1 To EOT
Print A$(N);
Next N
Dec EOT
Locate STAR+CHCNT-1,6
Curs On
End Proc
Procedure INSY
TEXL[" "]
TT=TT+T1
Inc EOT
For N=1 To EOT : T$(N)=A$(N) : Next N
A$(CHCNT)=" "
For N=CHCNT To EOT
X$=T$(N)
A$(N+1)=X$
Next N
Curs Off
Locate STAR,6
For N=1 To EOT
Print A$(N);
Next N
Curs On
Locate STAR+CHCNT-1,6
End Proc
Procedure CURSET
Flash 7,"(0f0,10)(fff,10)(f00,10)(fff,10)"
L1=%0
L2=%0
L3=%0
L4=%0
L5=%0
L6=%0
L7=%10000001
L8=%11111111
Set Curs L1,L2,L3,L4,L5,L6,L7,L8
Curs Pen 7
Curs On
Bell 50
End Proc
Procedure PLOPIT
If GOOD and TT<TLL
Print K$;
A$(CHCNT)=K$
If K$=" "
LASPC=CHCNT
End If
If CHCNT=>EOT
TEXL[K$]
TT=TT+T1
If TT>TLL-60
Bell 70-BEOH
Add BEOH,1,10 To 65
End If
If TT=>TLL
Boom : Wait 5
Curs Off
Locate STAR+LASPC,6
If LASPC>0
Cline EOT
Locate STAR,6
For N=1 To LASPC
Print A$(N);
Next N
For N=LASPC To EOT : A$(N)=" " : Next N
EOT=LASPC
TT=0
For N=1 To EOT
TEXL[A$(N)]
TT=TT+T1
Next N
End If
CHCNT=0
Locate STAR,6
Bell 20
End If
End If
K$=""
Inc CHCNT
Curs On
End If
End Proc
Procedure SETUP
ED
CURSET
Screen 5
Limit Mouse
Reserve Zone 12
Set Zone 1,16,24 To 50,39
Set Zone 2,456,25 To 500,40
Set Zone 3,528,24 To 572,40
Set Zone 4,14,88 To 232,99
Set Zone 5,16,107 To 230,119
Set Zone 6,180,69 To 202,77
Set Zone 7,210,69 To 230,77
Set Zone 8,510,75 To 554,91
Set Zone 9,468,101 To 512,116
Set Zone 10,556,101 To 602,117
Set Zone 11,392,74 To 434,117
Set Zone 12,192,19 To 320,31
Pen 0
Ink 0
Paper 1
KLIPPERT
If TXP=0
EOT=0
LASPC=0
CHCNT=1
Locate STAR,6
For N=1 To 80 : A$(N)=" " : Next N
If EOT>0
Cline EOT
End If
TXP=1
Else
Locate STAR,6
For N=1 To EOT : Print A$(N); : Next N
Locate CHCNT,6
End If
Locate STAR,6
SCUP=0
FRD=0
End Proc
Procedure OFFWEGO
Close Workbench
Close Editor
Voice 15
Volume 20
Mvolume 63
Music 1
Sample 1 To 15
'Load Iff "tit.iff",0
'Spack 0 To 10
'Stop
Unpack 10 To 1
Unpack 10 To 0
Get Palette 0
Flash Off : Curs Off
Locate ,20
Centre "Setting the fonts - please wait"
Wait 5
BEL=10
MUS=1
CM=1
SA=1
STAR=10
PCNT=0
TED=0
TXP=0
Get Fonts
' Cls
' For N=1 To 20
' Print N;" ";Font$(N)
'Next N
'Stop
Set Font 3
Set Font 4
Set Font 5
Set Font 6
Set Font 7
Set Font 8
Set Font 9
Set Font 10
''Stop
Get Rom Fonts
'
Set Font 2
Bank To Menu 9
Set Font 2
Pen 0
Locate ,20
Centre "Click the mouse button to start."
Pen 2 : Locate 31, : Print "LEFT"
Locate ,22
Pen 0
Centre "Click the mouse button to read/print the docs."
Pen 2 : Locate 24, : Print "RIGHT" : Pen 0
On Menu Proc MUS,CUL,FL,PGE,TEX,EX,DIS,EXT
Flash 2,"(f00,23)(0f0,23)(00f,23)(fc1,23)"
Repeat : MK=Mouse Key : Until MK<>0
Locate ,20 : Cline : Locate ,22 : Cline
If MK=2 Then DUCKS
' Screen 1 : Cls
' Screen 0 : Cls
SEF=5
' If Not Exist("DF0:books")
' Mkdir "df0:books"
' End If
Dir$="df0:books"
Set Dir 8,"*.dat"
Flash Off
Colour 2,$F00
Menu On
On Menu On
End Proc
Procedure PASTE
Screen 0
Ink 0
Set Font SEF
Z$=""
For N=1 To 80
Z$=Z$+A$(N)
Next N
Text LIX,LIY,Z$
Screen Copy 0 To 1
If LCNT=TLN
LCNT=1 : LIY=SLIY
Else
LIY=LIY+24
Inc LCNT
End If
Screen 5 : UPLINE : Screen 0
BUMP:
Set Font 2
Screen 5
End Proc
Procedure MOVTXSC
SCUP=-1
Wait Vbl
Screen Display 5,,175,,
For N=175 To 15 Step -1
Screen Display 5,,N,,
If N/2=Int(N/2)
Wait Vbl
End If
Next N
Wait Vbl
If Not FRD
FOURD
FRD=-1
End If
Screen 5
Limit Mouse
End Proc
Procedure KLIPPERT
Screen 0
Clip
' for text
If PSEL=1 Then Clip 5,5 To 635,250 : PTX=5 : PTY=5 : PBX=635 : PBY=250
If PSEL=2 Then Clip 5,5 To 305,250 : PTX=5 : PTY=5 : PBX=305 : PBY=250
If PSEL=3 Then Clip 5,150 To 635,250 : PTX=5 : PTY=150 : PBX=635 : PBY=250
If PSEL=4 Then Clip 5,225 To 635,250 : PTX=5 : PTY=225 : PBX=635 : PBY=250
Screen 5
End Proc
Procedure KLIPPERG
Screen 0
Clip
'for graphics
If PSEL=1 Then Clip 1,1 To 2,2 : PTX=1 : PTY=1 : PBX=2 : PBY=2
If PSEL=2 Then Clip 315,5 To 635,250 : PTX=315 : PTY=5 : PBX=635 : PBY=250
If PSEL=3 Then Clip 5,5 To 635,135 : PTX=5 : PTY=5 : PBX=635 : PBY=135
If PSEL=4 Then Clip 5,5 To 635,230 : PTX=5 : PTY=5 : PBX=635 : PBY=230
Screen 4
End Proc
Procedure DUN
FOURD
On Menu Off
Menu Off
Repeat : Until Mouse Click
FOURUP
Menu On
On Menu On
End Proc
Procedure FOURUP
N=300
If Rnd(5)=1
MESS[Space$(36)]
MESS[" Peek-A-Boo! "]
Else
MESS[Space$(36)]
MESS["Hello again!"]
End If
Wait Vbl
Screen Display 4,,N,,
Curs Off
For N=300 To 250 Step -1
Screen Display 4,,N,,
If N/2=Int(N/2) Then Wait Vbl
Next N
SCRPOS=250
Wait Vbl
FRD=0
End Proc
Procedure UPLINE
CL$=Str$(LCNT)
If LCNT<10 Then CL$=Right$(CL$,1) : CL$="0"+CL$
If LCNT=10 Then CL$=Right$(CL$,2)
If LCNT<=TLN
Ink 3,6
Text 155,75,CL$
Bell 5*LCNT+5
Else
Bell 20
LCNT=1 : LIY=SLIY
End If
Pen 0 : Paper 1
Locate STAR+CHCNT-1,6
End Proc
Procedure DWNLINE
CL$=Str$(LCNT)
If LCNT<10 Then CL$=Right$(CL$,1) : CL$="0"+CL$
If LCNT=10 Then CL$=Right$(CL$,2)
If LCNT<TLN+1
Ink 3,6
Text 155,75,CL$
Bell 5*LCNT+5
Else
Bell 20
End If
Pen 0 : Paper 1
Locate STAR+CHCNT-1,6
End Proc
Procedure MOVTXSCD
SCUP=0
Wait Vbl
For N=15 To 175
Screen Display 5,,N,,
If N/2=Int(N/2)
Wait Vbl
End If
Next N
Wait Vbl
Screen 5
Limit Mouse
End Proc
Procedure EXEC[C$]
'
' Open a input/output null channel
A$="NIL:"+Chr$(0)
Dreg(1)=Varptr(A$) : Dreg(2)=1004
HAND=Doscall(-30)
'
If HAND
'
' Send the command to AmigaDos
C$=C$+Chr$(0)
Dreg(1)=Varptr(C$) : Dreg(2)=HAND : Dreg(3)=HAND
F=Doscall(-222)
'
' Close the channel
Dreg(1)=HAND
A=Doscall(-36)
End If
'
' -1 if ok
End Proc[F]
Procedure SAVY
F$=Dir$
If Right$(F$,6)="books/" Then SETTIT
If Not CHANGED
Inc PCNT
End If
PAGE$="Page"+Str$(PCNT)
F$=Fsel$("",PAGE$,"Press return to save as new page","Or click on other page to replace this")
If F$<>""
Inc TP
If Not Exist("df0:doc")
BOMB
End If
If TP=>4
BOMB
End If
P=1
If PCNT>9
P=2
End If
PAGE$=Right$(F$,P)
PCNT=Val(PAGE$)
PAGE$="Page "+PAGE$
Change Mouse 3
MESS[Space$(36)]
MESS["Saving this page - please wait."]
Screen 0
Save Iff F$
P1$=Str$(PCNT) : P2$=Str$(PSEL) : P3$=Str$(LCNT) : P4$=Str$(TP)
Open Out 1,PAGE$+".dat"
Print #1,P1$
Print #1,P2$
Print #1,P3$
Print #1,P4$
Close 1
MESS[Space$(36)]
MESS["Please select a tool or menu item."]
Change Mouse CM
End If
On Menu On
CHANGED=0
End Proc
Procedure LOUD
F1$=Dir$
If Right$(F1$,6)="books/" Then SETTIT
If F$<>""
F$=Fsel$("","","Double Click on the page required","")
Change Mouse 3
P=1
If PCNT>9
P=2
End If
PAGE$=Right$(F$,P)
PCNT=Val(PAGE$)
PAGE$="Page "+PAGE$
MESS[Space$(36)]
MESS["Setting up new page - please wait."]
Open In 1,PAGE$+".dat"
Line Input #1,P1$
Line Input #1,P2$
Line Input #1,P3$
Line Input #1,P4$
Close 1
PCNT=Val(P1$) : PSEL=Val(P2$) : LCNT=Val(P3$) : TP=Val(P4$)
If TP>4
BOMB
End If
Load Iff F$,0
SETPAGE
Screen Copy 0 To 1
Screen 0 : Screen To Back : Screen 1 : Screen To Back
MESS[Space$(36)]
MESS["Please select a tool or menu item."]
Change Mouse CM
End If
On Menu On
CHANGED=-1
End Proc
Procedure DIS
If Choice(2)=1 Then SAVY
If Choice(2)=2 Then LOUD
If Choice(2)=3 Then SETTIT
If Choice(2)=4 Then DELP
If Choice(2)=5 Then DELB
End Proc
Procedure SETTIT
MESS[Space$(36)]
Locate 24,2
MESS["Enter your book's title: [ ]"]
GITIT
Curs Off
If F$<>""
Dir$="df0:books/"
TP=0
Inc BC
If Not Exist("df0:doc")
BOMB
End If
If BC=>3
BOMB
End If
MESS[Space$(38)]
If Not Exist(F$)
MESS["Setting up your new book"]
Mkdir F$
End If
MESS[Space$(38)]
M$=F$+" is ready to use."
MESS[M$]
Dir$=F$
CHANGED=-1
PCNT=1
Else
MESS[Space$(38)]
MESS["Please select a tool or menu item."]
End If
On Menu On
End Proc
Procedure DELP
' F$=Fsel$("","","Deleting","")
' If F$<>""
' Kill F$
' End If
' On Menu On
BOMB
End Proc
Procedure DELB
BOMB
End Proc
Procedure TEXL[X$]
Set Font SEF
T1=Text Length(X$)
Set Font 2
End Proc
Procedure CLTEX
Locate STAR,6 : If EOT>0 Then Cline EOT
CHCNT=1
EOT=0
BEOH=10
TT=0
LASPC=0
For N=1 To 80 : A$(N)=" " : Next N
End Proc
Procedure GITIT
Locate 50,2
F$=""
N=0
Curs On
Bell 50
Repeat
A$=Inkey$
A=Asc(A$)
If A>31 and A<128
F$=F$+A$
Print A$;
N=N+1
End If
If A=8 or N=11
F$=""
N=0
Locate 50,2
Cline 11
Bell 50
End If
Until A$=Chr$(13)
Curs Off
End Proc
Procedure DUCKS
'
Amos To Back
EXEC["ppmore doc"]
Amos To Front
'
End Proc
Procedure BOMB
Menu Off
On Menu Off
Hide
Break Off
Mvolume 60
Music 1
Unpack 14 To 5
Get Palette 5
Flash 0,"(fff,23)(f00,23)(0f0,23)(00f,23)(fc1,23)"
Colour 6,0
Screen Display 5,,100,,
Do :
Loop
End Proc